library(here)
library(tidyverse)
library(readr)
library(ggplot2)

# read and open data
## save data file as df

df <- read.csv(here('rateofdeath.csv'))

#exploring data
head(df)
##   measure_id measure_name location_id location_name sex_id sex_name age_id
## 1          1       Deaths         570    Washington      3     Both     22
## 2          1       Deaths         523       Alabama      3     Both     22
## 3          1       Deaths         539        Kansas      3     Both     22
## 4          1       Deaths         571 West Virginia      3     Both     22
## 5          1       Deaths         555      New York      3     Both     22
## 6          1       Deaths         534        Hawaii      3     Both     22
##   age_name cause_id           cause_name metric_id metric_name year       val
## 1 All ages      562 Opioid use disorders         3        Rate 1990 1.8782698
## 2 All ages      562 Opioid use disorders         3        Rate 1990 0.8859001
## 3 All ages      562 Opioid use disorders         3        Rate 1990 0.8549468
## 4 All ages      562 Opioid use disorders         3        Rate 1990 1.3670257
## 5 All ages      562 Opioid use disorders         3        Rate 1990 2.7087565
## 6 All ages      562 Opioid use disorders         3        Rate 1992 1.3763670
##       upper     lower
## 1 2.1146290 1.6561179
## 2 0.9941986 0.7878020
## 3 0.9640723 0.7650459
## 4 1.5184300 1.2275772
## 5 3.0503677 2.3778905
## 6 1.5490940 1.2099410
summary(df)
##    measure_id measure_name        location_id  location_name          sex_id 
##  Min.   :1    Length:1530        Min.   :523   Length:1530        Min.   :3  
##  1st Qu.:1    Class :character   1st Qu.:535   Class :character   1st Qu.:3  
##  Median :1    Mode  :character   Median :548   Mode  :character   Median :3  
##  Mean   :1                       Mean   :548                      Mean   :3  
##  3rd Qu.:1                       3rd Qu.:561                      3rd Qu.:3  
##  Max.   :1                       Max.   :573                      Max.   :3  
##    sex_name             age_id     age_name            cause_id  
##  Length:1530        Min.   :22   Length:1530        Min.   :562  
##  Class :character   1st Qu.:22   Class :character   1st Qu.:562  
##  Mode  :character   Median :22   Mode  :character   Median :562  
##                     Mean   :22                      Mean   :562  
##                     3rd Qu.:22                      3rd Qu.:562  
##                     Max.   :22                      Max.   :562  
##   cause_name          metric_id metric_name             year     
##  Length:1530        Min.   :3   Length:1530        Min.   :1990  
##  Class :character   1st Qu.:3   Class :character   1st Qu.:1997  
##  Mode  :character   Median :3   Mode  :character   Median :2004  
##                     Mean   :3                      Mean   :2004  
##                     3rd Qu.:3                      3rd Qu.:2012  
##                     Max.   :3                      Max.   :2019  
##       val              upper             lower        
##  Min.   : 0.4718   Min.   : 0.5292   Min.   : 0.4182  
##  1st Qu.: 2.2725   1st Qu.: 2.5425   1st Qu.: 2.0236  
##  Median : 5.0473   Median : 5.6695   Median : 4.5100  
##  Mean   : 6.2978   Mean   : 7.1181   Mean   : 5.5586  
##  3rd Qu.: 8.5806   3rd Qu.: 9.5911   3rd Qu.: 7.6202  
##  Max.   :38.4191   Max.   :47.7953   Max.   :31.5799
str(df)
## 'data.frame':    1530 obs. of  16 variables:
##  $ measure_id   : int  1 1 1 1 1 1 1 1 1 1 ...
##  $ measure_name : chr  "Deaths" "Deaths" "Deaths" "Deaths" ...
##  $ location_id  : int  570 523 539 571 555 534 553 572 552 550 ...
##  $ location_name: chr  "Washington" "Alabama" "Kansas" "West Virginia" ...
##  $ sex_id       : int  3 3 3 3 3 3 3 3 3 3 ...
##  $ sex_name     : chr  "Both" "Both" "Both" "Both" ...
##  $ age_id       : int  22 22 22 22 22 22 22 22 22 22 ...
##  $ age_name     : chr  "All ages" "All ages" "All ages" "All ages" ...
##  $ cause_id     : int  562 562 562 562 562 562 562 562 562 562 ...
##  $ cause_name   : chr  "Opioid use disorders" "Opioid use disorders" "Opioid use disorders" "Opioid use disorders" ...
##  $ metric_id    : int  3 3 3 3 3 3 3 3 3 3 ...
##  $ metric_name  : chr  "Rate" "Rate" "Rate" "Rate" ...
##  $ year         : int  1990 1990 1990 1990 1990 1992 1991 1990 1991 1992 ...
##  $ val          : num  1.878 0.886 0.855 1.367 2.709 ...
##  $ upper        : num  2.115 0.994 0.964 1.518 3.05 ...
##  $ lower        : num  1.656 0.788 0.765 1.228 2.378 ...
#deleting unnessecary columns

columns_to_delete <- c("measure_id", "measure_name","cause_id", "metric_id","cause_name","metric_name","age_id","sex_id","sex_name","age_name","upper","lower")
df <- df[, !(names(df) %in% columns_to_delete)]


#renaming collumns

##location_name change to state
colnames(df)[colnames(df) == "location_name"] <- "state"

##val change to number_deaths 
colnames(df)[colnames(df)=="val"] <-"death_rate"

#change to lower case
df$state <- tolower(df$state)


df <- df %>% mutate(number_deaths = as.numeric(death_rate))


#subset data set by year
##1990
desired_year1990 <- 1990
year1990 <- df[which(df$year == desired_year1990),]

##1991
desired_year1991 <- 1991
year1991 <- df[which(df$year == desired_year1991),]

##1992
desired_year1992 <- 1992
year1992 <- df[which(df$year == desired_year1992),]

##1993
desired_year1993 <- 1993
year1993 <- df[which(df$year == desired_year1993),]

##1994
desired_year1994 <- 1994
year1994 <- df[which(df$year == desired_year1994),]

##1995
desired_year1995 <- 1995
year1995 <- df[which(df$year == desired_year1995),]

##1996
desired_year1996 <- 1996
year1996 <- df[which(df$year == desired_year1996),]

##1997
desired_year1997 <- 1997
year1997 <- df[which(df$year == desired_year1997),]

##1998
desired_year1998 <- 1998
year1998 <- df[which(df$year == desired_year1998),]

##1999
desired_year1999 <- 1999
year1999 <- df[which(df$year == desired_year1999),]

##2000
desired_year2000 <- 2000
year2000 <- df[which(df$year == desired_year2000),]

##2001
desired_year2001 <- 2001
year2001 <- df[which(df$year == desired_year2001),]

##2002
desired_year2002 <- 2002
year2002 <- df[which(df$year == desired_year2002),]

##2003
desired_year2003 <- 2003
year2003 <- df[which(df$year == desired_year2003),]

##2004
desired_year2004 <- 2004
year2004 <- df[which(df$year == desired_year2004),]

##2005
desired_year2005 <- 2005
year2005 <- df[which(df$year == desired_year2005),]

##2006
desired_year2006 <- 2006
year2006 <- df[which(df$year == desired_year2006),]

##2007
desired_year2007 <- 2007
year2007 <- df[which(df$year == desired_year2007),]

##2008
desired_year2008 <- 2008
year2008 <- df[which(df$year == desired_year2008),]

##2009
desired_year2009 <- 2009
year2009 <- df[which(df$year == desired_year2009),]

##2010
desired_year2010 <- 2010
year2010 <- df[which(df$year == desired_year2010),]

##2011
desired_year2011 <- 2011
year2011 <- df[which(df$year == desired_year2011),]

##2012
desired_year2012 <- 2012
year2012 <- df[which(df$year == desired_year2012),]

##2013
desired_year2013 <- 2013
year2013 <- df[which(df$year == desired_year2013),]

##2014
desired_year2014 <- 2014
year2014 <- df[which(df$year == desired_year2014),]

##2015
desired_year2015 <- 2015
year2015 <- df[which(df$year == desired_year2015),]

##2016
desired_year2016 <- 2016
year2016 <- df[which(df$year == desired_year2016),]

##2017
desired_year2017 <- 2017
year2017 <- df[which(df$year == desired_year2017),]

##2018
desired_year2018 <- 2018
year2018 <- df[which(df$year == desired_year2018),]

##2019
desired_year2019 <- 2019
year2019 <- df[which(df$year == desired_year2019),]


# could make maps for every year, however these would all have their individual 
#scales for death rate and therefore the colour changing would only represent change for that specific year and not across the years  

library(maps)
us_states <- map_data("state")
head(us_states)
##        long      lat group order  region subregion
## 1 -87.46201 30.38968     1     1 alabama      <NA>
## 2 -87.48493 30.37249     1     2 alabama      <NA>
## 3 -87.52503 30.37249     1     3 alabama      <NA>
## 4 -87.53076 30.33239     1     4 alabama      <NA>
## 5 -87.57087 30.32665     1     5 alabama      <NA>
## 6 -87.58806 30.32665     1     6 alabama      <NA>
#change region to state in map data
colnames(us_states)[colnames(us_states) == "region"] <- "state"

#create map for 1990
p1990 <- ggplot(data = us_states,
            mapping = aes(x = long, y = lat,
                          group = group))

p1990 + geom_polygon(fill = "white", color = "black")

p1990 <- ggplot(data = us_states,
            aes(x = long, y = lat,
                group = group, fill = state))

p1990 + geom_polygon(color = "gray90", size = 0.1) + guides(fill = FALSE)

#align map to correct latitude and longitude
p1990 <- ggplot(data = us_states,
            mapping = aes(x = long, y = lat,
                          group = group, fill = state))

p1990 + geom_polygon(color = "gray90", size = 0.1) +
  coord_map(projection = "albers", lat0 = 39, lat1 = 45) +
  guides(fill = FALSE)

#join opioid death data with map data
map1990 <- left_join(year1990, us_states)

#plot opioid death on map data for 1990
p1990 <- ggplot(data = map1990,
            aes(x = long, y = lat,
                group = group, fill = death_rate))

p1990 + geom_polygon(color = "gray90", size = 0.1) +
  coord_map(projection = "albers", lat0 = 39, lat1 = 45) +
  scale_fill_gradient(low = "white", high = "darkred", na.value = "white", name = "Death Rate per 100,000")

#make a loop for all death maps 1990-2019
#keep death rate scale constant through all years to show true change in death rate

overall_scale_limits <- range(df$death_rate, na.rm = TRUE)

generate_and_save_map <- function(current_year) {
  current_data <- df %>% filter(year == current_year)
  map_data <- left_join(current_data, us_states, by = "state")
  
  p <- ggplot(data = map_data,
              aes(x = long, y = lat,
                  group = group, fill = death_rate)) +
    geom_polygon(color = "black", size = 0.1) +
    coord_map(projection = "albers", lat0 = 39, lat1 = 45) +
    scale_fill_gradient(low = "white", high = "darkred", na.value = "yellow", 
                        name = "Death Rate per 100,000", limits = overall_scale_limits) +
    ggtitle(paste("US Opioid-Use Related Death Rate - Year", current_year)) +
    labs(subtitle = "Institute for Health Metrics and Evaluation") +
    theme(plot.title = element_text(size = 18, face = "bold"),
          plot.subtitle = element_text(size = 14),
          panel.grid.major = element_blank(),  # Remove major gridlines
          panel.grid.minor = element_blank(),
          panel.background = element_rect(fill = "transparent"))
  
  # Save the plot as an image
  ggsave(filename = paste("opioid_death_map_", current_year, ".png", sep = ""), plot = p)
}

# Generate and save frames for each year
lapply(1990:2019, generate_and_save_map)
## [[1]]
## [1] "opioid_death_map_1990.png"
## 
## [[2]]
## [1] "opioid_death_map_1991.png"
## 
## [[3]]
## [1] "opioid_death_map_1992.png"
## 
## [[4]]
## [1] "opioid_death_map_1993.png"
## 
## [[5]]
## [1] "opioid_death_map_1994.png"
## 
## [[6]]
## [1] "opioid_death_map_1995.png"
## 
## [[7]]
## [1] "opioid_death_map_1996.png"
## 
## [[8]]
## [1] "opioid_death_map_1997.png"
## 
## [[9]]
## [1] "opioid_death_map_1998.png"
## 
## [[10]]
## [1] "opioid_death_map_1999.png"
## 
## [[11]]
## [1] "opioid_death_map_2000.png"
## 
## [[12]]
## [1] "opioid_death_map_2001.png"
## 
## [[13]]
## [1] "opioid_death_map_2002.png"
## 
## [[14]]
## [1] "opioid_death_map_2003.png"
## 
## [[15]]
## [1] "opioid_death_map_2004.png"
## 
## [[16]]
## [1] "opioid_death_map_2005.png"
## 
## [[17]]
## [1] "opioid_death_map_2006.png"
## 
## [[18]]
## [1] "opioid_death_map_2007.png"
## 
## [[19]]
## [1] "opioid_death_map_2008.png"
## 
## [[20]]
## [1] "opioid_death_map_2009.png"
## 
## [[21]]
## [1] "opioid_death_map_2010.png"
## 
## [[22]]
## [1] "opioid_death_map_2011.png"
## 
## [[23]]
## [1] "opioid_death_map_2012.png"
## 
## [[24]]
## [1] "opioid_death_map_2013.png"
## 
## [[25]]
## [1] "opioid_death_map_2014.png"
## 
## [[26]]
## [1] "opioid_death_map_2015.png"
## 
## [[27]]
## [1] "opioid_death_map_2016.png"
## 
## [[28]]
## [1] "opioid_death_map_2017.png"
## 
## [[29]]
## [1] "opioid_death_map_2018.png"
## 
## [[30]]
## [1] "opioid_death_map_2019.png"
# Install and load the magick package
library(magick)

# Get the list of PNG files in the current directory
file_names <- list.files(pattern = "\\.png$", full.names = TRUE)

# Read the PNG files into R as magick images
images <- image_read(file_names)


animation <- image_animate(images, fps = 2)

# Specify the output format as GIF when writing the animation
animation_file <- "output.gif"
image_write(animation, animation_file, format = "gif")

#making maps that change by year and you can look at inidividual death rate for each state

library(shiny)
library(shinyWidgets)
## Warning: package 'shinyWidgets' was built under R version 4.3.3
map_changing <- fluidPage(
  titlePanel("US Opioid-Use Related Death Rate"),
  
  # Create a slider input for selecting the year
  sliderTextInput("year", "Select Year:",
                  choices = as.character(1990:2019), selected = "1990"),
  
  # Display the plot
  plotOutput("map")
)

server <- function(input, output) {
  # Generate the plot based on the selected year
  output$map <- renderPlot({
    current_data <- df %>% filter(year == input$year)
    map_data <- left_join(current_data, us_states, by = "state")
    
    ggplot(data = map_data,
           aes(x = long, y = lat,
               group = group, fill = death_rate)) +
      geom_polygon(color = "black", size = 0.1) +
      coord_map(projection = "albers", lat0 = 39, lat1 = 45) +
      scale_fill_gradient(low = "white", high = "red", na.value = "yellow", 
                          name = "Death Rate", limits = overall_scale_limits) +
      ggtitle(paste("US Opioid-Use Related Death Rate - Year", input$year)) +
      labs(subtitle = "Institute for Health Metrics and Evaluation") +
      theme(plot.title = element_text(size = 18, face = "bold"),
            plot.subtitle = element_text(size = 14),
            panel.grid.major = element_blank(),  
            panel.grid.minor = element_blank(),
            panel.background = element_rect(fill = "transparent"))
  })
}

shinyApp(map_changing, server)
Shiny applications not supported in static R Markdown documents
#Combine shiny and plotly to make an interactive map where you can hover over the states to see a value and also go through year by year



library(plotly)
## Warning: package 'plotly' was built under R version 4.3.3
## 
## Attaching package: 'plotly'
## The following object is masked from 'package:ggplot2':
## 
##     last_plot
## The following object is masked from 'package:stats':
## 
##     filter
## The following object is masked from 'package:graphics':
## 
##     layout
map_changing <- fluidPage(
  titlePanel("US Opioid-Use Related Death Rate"),
  
  # Create a slider input for selecting the year
  sliderTextInput("year", "Select Year:",
                  choices = as.character(1990:2019), selected = "1990"),
  
  # Display the plot
  plotlyOutput("map")
)

server <- function(input, output) {
  # Generate the plot based on the selected year
  output$map <- renderPlotly({
    current_data <- df %>% filter(year == input$year)
    map_data <- left_join(current_data, us_states, by = "state")
    
    p <- ggplot(data = map_data,
                aes(x = long, y = lat,
                    group = group, fill = death_rate, text = paste("State: ", state, "<br>Death Rate: ", death_rate))) +
      geom_polygon(color = "black", size = 0.1) +
      coord_map() +
      scale_fill_gradient(low = "white", high = "darkred", na.value = "yellow", 
                          name = "Death Rate", limits = overall_scale_limits) +
      ggtitle(paste("US Opioid-Use Related Death Rate - Year", input$year)) +
      labs(subtitle = "Institute for Health Metrics and Evaluation") +
      theme(plot.title = element_text(size = 18, face = "bold"),
            plot.subtitle = element_text(size = 14),
            panel.grid.major = element_blank(),  
            panel.grid.minor = element_blank(),
            panel.background = element_rect(fill = "transparent"))
    
    ggplotly(p) %>% layout(geo = list(projection = list(type = 'albers usa'))) 
  })
}



shinyApp(map_changing, server)
Shiny applications not supported in static R Markdown documents